home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / RSTART.f < prev    next >
Encoding:
Text File  |  1992-07-31  |  2.9 KB  |  103 lines
  1.       SUBROUTINE RSTART 
  2. *-----------------------------------------------------------------------
  3. *   
  4. *   Processes the routine start 
  5. *   
  6. *-----------------------------------------------------------------------
  7.       include 'PARAM.h' 
  8.       include 'ALCAZA.h' 
  9.       include 'CLASS.h' 
  10.       include 'FLAGS.h' 
  11.       include 'CURSTA.h' 
  12.       include 'STATE.h' 
  13.       include 'TREECOM.h' 
  14.       LOGICAL FLOC  
  15. *--- reset modify and filter flag   
  16.       DO 10 I=1,NSTAMM  
  17.          IMODIF(I)=0
  18.    10 CONTINUE  
  19. *--- only initialize for new routine if really true 
  20.       IF(.NOT.STATUS(6))  THEN  
  21.          IF(ACTION(24)) THEN
  22. *--- reset counters and flags for c.b. names
  23.             STATUS(12)=.FALSE.  
  24.             STATUS(13)=.FALSE.  
  25.             NCBNAM=0
  26.             NEQNAM=0
  27.             NCBVAR=0
  28.             DO 20 I=1,MAXGRP
  29.                LCBNAM(I)=0  
  30.    20       CONTINUE
  31.             DO 30 I=1,MXNAME
  32.                LCBVAR(I)=0  
  33.    30       CONTINUE
  34.          ENDIF  
  35.          IF(ACTION(29)) THEN
  36. *--- reset counters for TREE
  37.             NCALLR=0
  38.             NCALLD=0
  39.             NEXEL=0 
  40.          ENDIF  
  41. *--- set flag to re-initialize filters  
  42.          IFILTR=-1  
  43. *--- 'print routine header' flag
  44.          STATUS(9)=.TRUE.   
  45. *--- reset SUBROUTINE flag  
  46.          STATUS(14)=.FALSE. 
  47. *--- get routine name   
  48.          DO 40 I=1,NSTAMM   
  49.             IF (ICLASS(I,1).NE.0) GOTO 50   
  50.    40    CONTINUE   
  51. *--- only comments  
  52.          SCROUT='COMMENTS'  
  53.          GOTO 60
  54.    50    CONTINUE   
  55.          CALL EXTRAC(I,'PART')  
  56.          CALL CLASSF
  57. *--- find routine name  
  58.          IF (ISTMDS(14,ICURCL(1)).NE.0)  THEN   
  59. *--- proper routine header  
  60.             STATUS(14)=ISTMDS(6,ICURCL(1)).EQ.66
  61.             FLOC=ACTION(10) 
  62.             ACTION(10)=.TRUE.   
  63.             ISNAME=IRNAME+NRNAME
  64.             CALL GETALL 
  65.             ACTION(10)=FLOC 
  66.             IF(NSNAME.GT.0)  THEN   
  67.                SCROUT=SNAMES(ISNAME+1)  
  68.             ELSEIF(ISTMDS(6,ICURCL(1)).EQ.4)  THEN  
  69.                SCROUT='BLOCKDAT'
  70.             ELSE
  71.                SCROUT='NOHEADER'
  72.             ENDIF   
  73.          ELSE   
  74.             SCROUT='NOHEADER'   
  75.          ENDIF  
  76.    60    CONTINUE   
  77. *--- reset variable type routine
  78.          IF (ACTION(20)) CALL SETTYP(0) 
  79. *--- preset 'routine filtered' flag 
  80.          STATUS(7)=.TRUE.   
  81. *--- filter for routine names   
  82.          IF (ACTION(16)) CALL FILTER(10,7)  
  83.       ENDIF 
  84. *--- process only if routine selected   
  85.       IF (STATUS(7))  THEN  
  86. *--- classify all statements
  87.          DO 70 J=1,NSTAMM   
  88.             IF (ICLASS(J,1).NE.0)  THEN 
  89.                CALL EXTRAC(J,'FULL')
  90.                CALL CLASSF  
  91.                ICLASS(J,1)=ICURCL(1)
  92.                ICLASS(J,2)=ICURCL(2)
  93.             ENDIF   
  94.    70    CONTINUE   
  95. *--- prepare re-numbering if requested  
  96.          IF (ACTION(13)) CALL PRENUM
  97.       ENDIF 
  98. *--- reset variables
  99.       KNTDO=0   
  100.       KNTIF=0   
  101.       WRITE(MPUNIT,'(2A)') '  +++ start processing routine:  ',SCROUT   
  102.       END   
  103.